{*******************************************************************************
* The contents of this file are used with permission, subject to the Mozilla   *
* Public License Version 1.1 (the "License"); you may not use this file except *
* in compliance with the License. You may obtain a copy of the License at      *
* http://www.mozilla.org/MPL/                                                  *
*                                                                              *
* Software distributed under the License is distributed on an "AS IS" basis,   *
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for *
* the specific language governing rights and limitations under the License.    *
*                                                                              *
* The Original Code is distributed as part of the "mediate" product and is     *
* Copyright (C) @home media limited. All Rights Reserved.                      *
*                                                                              *
* Email: support@athomemedia.co.uk                                             *
* Web:   http://www.athomemedia.co.uk                                          *
*******************************************************************************}

unit XMLTags;

interface

uses Classes;

const
  // Attribute values
  ATTR_VAL_YES = 'yes';
  ATTR_VAL_NO = 'no';
  ATTR_VAL_TRUE = 'true';

  // Array of tabs used to format XML representation of UI objects
  TABS: array[1..5] of String = ('  ', '        ', '          ',
                                 '                ', '                  ');
  // Constants used to form XML tags
  TGB = '<'; // Tag Open
  TGC = '>'; // Begin/End Tag Close
  TGE = '</'; // End Tag Open
  SPC = ' '; // Space between attributes
  ATB = '="'; // Attribute name="value"
  ATN = '" '; // Close attribute + space for next
  ATQ = '"'; // Close attribute only (attribute quote)
  ATC = '">'; // Close attribute + close Begin/End tag
  ATE = '"/>'; // Close attribute + close Empty tag
  ETE = '/>'; // Close Empty tag
  COMMENT_BEGIN = '<!--'; // Comment Begin tag
  COMMENT_END = '-->'; // Comment End tag

  // XML encoding declaration for start of each file
  XML_PREAMBLE = '<?xml version="1.0" encoding="iso-8859-1" ?>';

  // XML helper functions
  function BeginTag(TagName: String): String;
  function EndTag(TagName: String): String;
  function Bool2Str(Value: Boolean): String;
  function Str2Bool(Value: String): Boolean;
  function Float2Str(Value: Extended): String;
  function FormatXMLComment(const Comment: String): String; overload;
  procedure FormatXMLComment(Comment: String; Indent: Integer; Lines: TStrings); overload;
  function EncodeXML(const RawValue: String): String;
  function EncodeXMLValue(const RawValue: String): String;

implementation

uses SysUtils;

  function BeginTag(TagName: String): String;
  begin
    Result := TGB + TagName + TGC;
  end;

  function EndTag(TagName: String): String;
  begin
    Result := TGE + TagName + TGC;
  end;

  function Bool2Str(Value: Boolean): String;
  begin
    if Value then
      Result := ATTR_VAL_YES
    else
      Result := ATTR_VAL_NO;
  end;

  function Str2Bool(Value: String): Boolean;
  begin
    Result := (Value = ATTR_VAL_YES) or (Value = ATTR_VAL_TRUE);
  end;

  function Float2Str(Value: Extended): String;
  begin
    Result := FloatToStrF(Value, ffFixed, 7, 2);
  end;
  
  function FormatXMLComment(const Comment: String): String;
  var
    i: Integer;
  begin
    Result := '';

    // Encode passed XML comment only using ISO-8859-1 character set.
    // NB: encoding only replaces extended characters and removes any occurrence
    // of "--" string which is not permitted within a comment
    for i := 1 to Length(Comment) do
      case Ord(Comment[i]) of
        9, 10, 13: Result := Result + Comment[i];
        32..126:   Result := Result + Comment[i];
        160..255:  Result := Result + '&#' + IntToStr(Ord(Comment[i])) + ';';
      end;

    // Replace any occurrences of "--" with a single hypen character
    while Pos('--', Result) > 0 do
      Delete(Result, Pos('--', Result), 1);

    // Wrap comment with standard delimiters
    Result := COMMENT_BEGIN + Result + COMMENT_END;
  end;

  procedure FormatXMLComment(Comment: String; Indent: Integer; Lines: TStrings);
  var
    Temp: TStringList;
  begin
    // Use a stringlist to perform formatting of lines
    Temp := TStringList.Create;
    try
      Temp.Text := TABS[Indent] + FormatXMLComment(Comment);
      Lines.AddStrings(Temp);
    finally
      Temp.Free;
    end;
  end;

  function EncodeXML(const RawValue: String): String;
  var
    i: Integer;
  begin
    Result := '';

    // Encode passed XML value or tag using ISO-8859-1 character set
    for i := 1 to Length(RawValue) do
      case Ord(RawValue[i]) of
        9, 10, 13, 32, 33, 61: Result := Result + RawValue[i];
        34:                    Result := Result + '&quot;';
        35..37:                Result := Result + RawValue[i];
        38:                    Result := Result + '&amp;';
        39..59:                Result := Result + RawValue[i];
        60:                    Result := Result + '&lt;';
        62:                    Result := Result + '&gt;';
        63..126:               Result := Result + RawValue[i];
        160..255:              Result := Result + '&#' + IntToStr(Ord(RawValue[i])) + ';';
      end;
  end;

  function EncodeXMLValue(const RawValue: String): String;
  var
    i: Integer;
  begin
    Result := '';

    // Encode passed XML value only using ISO-8859-1 character set.
    // NB: encoding is as above with exception of quote characters which are
    // permitted within Tag values, but not tag names
    for i := 1 to Length(RawValue) do
      case Ord(RawValue[i]) of
        9, 10, 13, 32, 33, 61: Result := Result + RawValue[i];
        34..37:                Result := Result + RawValue[i];
        38:                    Result := Result + '&amp;';
        39..59:                Result := Result + RawValue[i];
        60:                    Result := Result + '&lt;';
        62:                    Result := Result + '&gt;';
        63..126:               Result := Result + RawValue[i];
        160..255:              Result := Result + '&#' + IntToStr(Ord(RawValue[i])) + ';';
      end;
  end;


end.
